Matthew Boone, Rocio Joo, Mathieu Basille
Ecology Society of America conference 2020
Build a movement framework that the community will buy into
Flexible enough to contain ever expanding structures of movement models
Make methods and documentation transparent
Fully compatible with sf, tidyverse, and ggplot
Our goals are not to replace any of these existing packages. But to create a class that is flexible enough to be used by all these packages.
animal_id timestamp longitude latitude fix
TTP-053:2753 2018-07-26 15:02:30-04: 4 Min. :-80.89 Min. : 0.00 2D :1978
TTP-026:2718 2018-07-30 02:02:30-04: 4 1st Qu.:-80.28 1st Qu.: 0.00 3D :9570
TTP-014:2598 2018-08-01 17:02:30-04: 4 Median :-80.27 Median :26.07 NO :5517
TTP-041:2511 2018-07-25 15:02:30-04: 3 Mean :-54.89 Mean :17.83 NULL: 382
TTP-002:2264 2018-07-25 18:02:30-04: 3 3rd Qu.: 0.00 3rd Qu.:26.07
TTP-058:2258 2018-07-25 20:02:30-04: 3 Max. : 0.00 Max. :27.89
(Other):2345 (Other) :17426
devtools::install_github("mablab/sftrack")
raccoon <- read.csv('my_data/raccoon_data.csv')
summary(raccoon)
Prepare
library(lubridate)
raccoon$timestamp <- ymd_hms(raccoon$timestamp)
# lat/long crs
wsg <- 'EPSG:4326'
Create
my_sftrack <- as_sftrack(raccoon, burst = 'animal_id', time = 'timestamp',
coords = c('longitude', 'latitude'), crs=wsg, zeroNA = TRUE)
plot(my_sftrack, axes = T, graticule = TRUE, pch = 4, lwd=4)
my_sftrack <- my_sftrack[c('TTP-058','TTP-041'),]
print(my_sftrack, n_row=12)
Sftrack with 4769 features and 7 fields (2236 empty geometries)
Geometry : "geometry" (XY, crs: EPSG:4326)
Timestamp : "timestamp" (POSIXct in UTC)
Burst : "burst" (*id*)
-------------------------------
animal_id timestamp longitude latitude fix burst geometry
10891 TTP-041 2019-01-15 17:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
3351 TTP-041 2019-01-16 17:02:30 -80.27812 26.06610 3D (id: TTP-041) POINT (-80.27812 26.0661)
3352 TTP-041 2019-01-17 17:02:30 -80.27830 26.06561 3D (id: TTP-041) POINT (-80.2783 26.06561)
3353 TTP-041 2019-01-18 17:02:30 -80.27835 26.06566 3D (id: TTP-041) POINT (-80.27835 26.06566)
3354 TTP-041 2019-01-19 00:02:30 -80.27531 26.06607 3D (id: TTP-041) POINT (-80.27531 26.06607)
3355 TTP-041 2019-01-19 01:02:05 -80.27620 26.06573 3D (id: TTP-041) POINT (-80.2762 26.06573)
3356 TTP-041 2019-01-19 02:02:05 -80.27636 26.06859 3D (id: TTP-041) POINT (-80.27636 26.06859)
10892 TTP-041 2019-01-19 03:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
10893 TTP-041 2019-01-19 04:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
10894 TTP-041 2019-01-19 05:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
15584 TTP-041 2019-01-19 06:02:30 -80.27873 26.06819 2D (id: TTP-041) POINT (-80.27873 26.06819)
10895 TTP-041 2019-01-19 07:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
library(OpenStreetMap)
# Get bounding box from sf geometry
bbox <- st_bbox(my_sftrack)
lower_right <- bbox[c(2,3)] + c(-0.01,0.2)
upper_left <- bbox[c(4,1)] + c(0.01,-0.2)
# download open street map
map <- openmap(upper_left,lower_right,
zoom=11, type='osm')
# project map
map <- openproj(map)
plot(map)
plot(my_sftrack, add= T, pch=4, lwd=2, col = 'black')
utm_17 <- '+proj=utm +zone=17 +ellps=WGS84 +datum=WGS84 +units=m +no_defs'
my_sftrack <- st_transform(my_sftrack, crs = utm_17)
# Make a polygon within study
poly_pts <- list(
rbind(
c(572300, 2883500),
c(572600, 2883500),
c(572600, 2883700),
c(572300, 2883700),
c(572300, 2883500)
)
)
polygon <- st_sfc(st_polygon(poly_pts), crs=utm_17)
# What points are within a polygon?
plot(polygon, axes= T, graticule = TRUE, expandBB = c(1.5,1.5,1.5,1.5), col =sf.colors(alpha=0.2))
plot(my_sftrack, add =T)
answer <- st_within(my_sftrack, polygon, sparse=FALSE)
sub_sftrack <- my_sftrack[answer, ]
head(sub_sftrack)
Sftrack with 6 features and 7 fields (0 empty geometries)
Geometry : "geometry" (XY, crs: +proj=utm +zone=17 +ellps=WGS84 +datum=WGS84 +units=m +no_defs)
Timestamp : "timestamp" (POSIXct in UTC)
Burst : "burst" (*id*)
-------------------------------
animal_id timestamp longitude latitude fix burst geometry
3382 TTP-041 2019-01-24 02:02:09 -80.27637 26.07026 3D (id: TTP-041) POINT (572377.1 2883665)
15601 TTP-041 2019-01-28 20:02:30 -80.27576 26.06974 2D (id: TTP-041) POINT (572438.2 2883608)
3425 TTP-041 2019-02-03 19:02:14 -80.27701 26.07041 3D (id: TTP-041) POINT (572313.6 2883681)
3426 TTP-041 2019-02-03 20:02:08 -80.27466 26.07010 3D (id: TTP-041) POINT (572548.8 2883649)
3482 TTP-041 2019-02-13 02:02:09 -80.27630 26.06926 3D (id: TTP-041) POINT (572385.2 2883555)
17035 TTP-041 2019-02-22 02:02:20 -80.27497 26.06999 3D (id: TTP-041) POINT (572517.3 2883636)
step_calc <- step_metrics(my_sftrack)
head(step_calc)
dx dy dist dt abs_angle speed sftrack_id
1 NA NA NA 86400 NA 0.000000e+00 TTP-041_2019-01-15 17:02:30
2 -18.008768 -53.593639 56.538428 86400 -1.8949668 6.543800e-04 TTP-041_2019-01-16 17:02:30
3 -4.727009 4.625484 6.613601 86400 2.3670495 7.654631e-05 TTP-041_2019-01-17 17:02:30
4 303.425593 47.756375 307.160807 25200 0.1561101 1.218892e-02 TTP-041_2019-01-18 17:02:30
5 -89.014047 -38.261403 96.888779 3575 -2.7356334 2.710176e-02 TTP-041_2019-01-19 00:02:30
6 -17.864152 316.988342 317.491318 3600 1.6270926 8.819203e-02 TTP-041_2019-01-19 01:02:05
summary(step_calc)
dx dy dist dt abs_angle
Min. :-9821.837 Min. :-9016.561 Min. : 0.00 Min. : 872 Min. :-3.1390
1st Qu.: -55.167 1st Qu.: -75.025 1st Qu.: 28.16 1st Qu.: 3584 1st Qu.:-1.5906
Median : -0.312 Median : -1.547 Median : 125.38 Median : 3600 Median :-0.1664
Mean : -14.602 Mean : -2.238 Mean : 224.22 Mean : 5561 Mean :-0.0418
3rd Qu.: 45.378 3rd Qu.: 54.129 3rd Qu.: 288.37 3rd Qu.: 3600 3rd Qu.: 1.5806
Max. : 1700.460 Max. :14427.086 Max. :14427.40 Max. :86400 Max. : 3.1413
NA's :2793 NA's :2793 NA's :2793 NA's :2 NA's :2794
speed sftrack_id
Min. :0.00000 Length:4769
1st Qu.:0.00000 Class :character
Median :0.00000 Mode :character
Mean :0.03341
3rd Qu.:0.02658
Max. :7.70282
NA's :2
# Filter out by travel distance
my_sftrack <- my_sftrack[!is.na(step_calc$dist) &step_calc$dist<200,]
library(OpenStreetMap)
map_zoom <-
openmap(c(26.078,-80.292),c(26.062,-80.262),
zoom=15, type='osm')
# project to UTM 17
map_zoom <- openproj(map_zoom, utm_17)
plot(map_zoom)
plot(my_sftrack, add= T, pch=4, lwd=2)
my_sftraj <- as_sftraj(my_sftrack)
head(my_sftraj)
Sftraj with 6 features and 7 fields (0 empty geometries)
Geometry : "geometry" (XY, crs: +proj=utm +zone=17 +ellps=WGS84 +datum=WGS84 +units=m +no_defs)
Timestamp : "timestamp" (POSIXct in UTC)
Burst : "burst" (*id*)
-------------------------------
animal_id timestamp longitude latitude fix burst
3351 TTP-041 2019-01-16 17:02:30 -80.27812 26.06610 3D (id: TTP-041)
3352 TTP-041 2019-01-17 17:02:30 -80.27830 26.06561 3D (id: TTP-041)
3354 TTP-041 2019-01-19 00:02:30 -80.27531 26.06607 3D (id: TTP-041)
3358 TTP-041 2019-01-19 20:02:17 -80.27875 26.07387 3D (id: TTP-041)
3360 TTP-041 2019-01-19 22:02:08 -80.27848 26.07533 3D (id: TTP-041)
3366 TTP-041 2019-01-21 05:02:30 -80.27702 26.06576 3D (id: TTP-041)
geometry
3351 LINESTRING (572205.1 288320...
3352 LINESTRING (572187.1 288315...
3354 LINESTRING (572485.8 288320...
3358 LINESTRING (572137.3 288406...
3360 LINESTRING (572163.3 288422...
3366 LINESTRING (572314.8 288316...
plot(my_sftraj, graticule = TRUE, key.pos=4, main = 'Tree Tops Park Raccoons')
data('raccoon',package='sftrack')
raccoon$timestamp <- ymd_hms(raccoon$timestamp)
# create a new month category
raccoon$month <- month(raccoon$timestamp)
burst = c(id = 'animal_id', month = 'month')
my_sftraj <- as_sftraj(raccoon, burst = burst,
time = 'timestamp', coords = c('longitude', 'latitude'),
crs=wsg, zeroNA = TRUE)
# Check out what group is active
active_burst(my_sftraj)
[1] "id" "month"
plot(my_sftraj, graticule = TRUE)
active_burst(my_sftraj) <- 'id'
plot(my_sftraj, graticule = TRUE)
sf plot methods.sftraj class and grouping structure
@birderboone
github/birderboone
mablab.org